home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_geomview.idb / usr / freeware / lib / geomview / modules / tcl / NDview.z / NDview
Encoding:
Text File  |  1999-01-26  |  12.2 KB  |  415 lines
  1. #!./testwish
  2.  
  3. emodule_init ndview
  4.  
  5. if [catch {set ndroot $env(GEOMROOT)/data/NDview}] {
  6.     puts stderr "Normally, modules are run in an environment in which the GEOMROOT environment\nvariable is set, which has not been done.  This is done by the geomview\nshell script:  please check your shell script.\n"
  7.     exit 1
  8. }
  9.  
  10. proc setentry {entry value} {
  11.     $entry delete 0 end
  12.     $entry insert 0 $value
  13. }
  14.  
  15. # useful routines.
  16.  
  17. proc viewfile {path file} {
  18.     global ndroot
  19.     set f [open $ndroot/$file]
  20.  
  21.     catch {destroy $path};
  22.     toplevel $path
  23.     text $path.text -relief sunken -bd 2 -yscrollcommand "$path.scroll set" \
  24.     -width 50
  25.     scrollbar $path.scroll -command "$path.text yview"
  26.     button $path.done -command "destroy $path" -text "Done"
  27.     pack $path.done -side bottom -anchor se
  28.     pack $path.scroll -side right -fill y -anchor w
  29.     pack $path.text -side right -expand 1 -fill both
  30.  
  31.     $path.text insert end [read $f]
  32.     $path.text configure -state disabled
  33.     close $f
  34.     wm minsize $path 300 300
  35.     wm title $path $file
  36. }
  37.  
  38. ################################################################
  39. # Top row of buttons
  40.  
  41. # code to change selection
  42.  
  43. proc selected_basis {} {
  44.     global update
  45.     ndview_set_update $update
  46. }
  47.  
  48. proc unselected_basis {} {
  49.     ndview_set_update none
  50. }
  51.  
  52. proc selected_toolkit {} {
  53.     ndview_update_dimension
  54. }
  55.  
  56. proc setselect {i} {
  57.     global selected
  58.     catch unselected_$selected
  59.     foreach j {intro prefab toolkit basis basis_needmore} {
  60.     catch {pack forget .$j}
  61.     .sf.select.$j configure -relief raised -state normal
  62.     }
  63.     if \"$selected\"==\"$i\" {
  64.     set selected none
  65.     } else {
  66.     .sf.select.$i configure -relief sunken
  67.     pack .$i -expand 1 -fill both
  68.     set selected $i
  69.     catch selected_$i
  70.     }
  71. }
  72.  
  73. proc mkTop {} {
  74.     frame .sf
  75.     frame .sf.select
  76.     button .sf.select.intro -text "Introduction" -command "setselect intro"
  77.     button .sf.select.prefab -text "Prefabricated" -command "setselect prefab"
  78.     button .sf.select.toolkit -text "Toolkit" -command "setselect toolkit"
  79.     button .sf.select.basis -text "Basis vectors" -command {
  80.     ndview_update_dimension
  81.     if "$dimension > 3" {setselect basis} else {setselect basis_needmore}
  82.     }
  83.     proc .sf.select.basis_needmore {args} {eval ".sf.select.basis $args"}
  84.     button .quit -text "Quit NDview" -command "destroy ."
  85.     
  86.     pack .sf.select.intro .sf.select.prefab .sf.select.toolkit \
  87.     .sf.select.basis -side left -anchor n -expand 1
  88.     label .sf.select.space -text " "
  89.     pack .sf.select.space -padx 8 -side left
  90.     pack .quit -side right -anchor ne -in .sf.select -expand 1
  91.  
  92.     # unfortunately we have to do this, as there's a bug in tix.
  93.     pack .sf.select -padx 4 -pady 4 -expand 1 -fill x
  94.     pack .sf -expand 1 -fill x
  95. }
  96.  
  97.  
  98. ################################################################
  99. # Introduction screen
  100.  
  101. proc mkIntro {} {
  102.     frame .intro
  103.     
  104.     button .intro.help -text "Introductory help" \
  105.     -command "viewfile .intro.help.panel text/introhelp.txt"
  106.     button .intro.demo -text "Introductory demo" -command {
  107.     puts "(emodule-start NDdemo)";
  108.     flush stdout
  109.     }
  110.     label .intro.title1 -text "NDview 1.1"
  111.     label .intro.title2 -text "Tcl/Tk version by Nils McCarthy"
  112.     label .intro.title3 -text "Original version by Olaf Holt and Stuart Levy"
  113.     pack .intro.title1 .intro.title2 .intro.title3 -side top
  114.     pack .intro.help -side left -padx 4 -pady 2
  115.     pack .intro.demo -side right -padx 4 -pady 2
  116. }
  117.  
  118.  
  119. ################################################################
  120. # Prefabricated stuff
  121.  
  122. # define a nice listbox with scroll bar and labe.
  123. proc mylistbox {path short title command} {
  124.     global mylistbox_val_$short
  125.     frame $path
  126.     listbox $path.box -yscrollcommand "$path.scroll set" -relief sunken \
  127.     -selectmode browse -width 12 -height 5
  128.     bind $path.box <ButtonRelease-1> "$command \$mylistbox_val_${short}(\[selection get\])"
  129.     label $path.label -text $title
  130.     scrollbar $path.scroll -command "$path.box yview"
  131.     pack $path.label -side top -fill x
  132.     pack $path.scroll -side right -fill y
  133.     pack $path.box -side right -expand 1 -fill both
  134.     foreach i [lsort [array names mylistbox_val_$short]] {
  135.     $path.box insert end $i
  136.     }
  137. }
  138.  
  139. # read in data file from .ndview
  140. proc readndview {file} {
  141.     if ![catch {set f [open $file r]}] {
  142.     while {[gets $f line] > -1} {
  143.         if [regexp {^(.+):(.+):(.+)$} $line matchvar label module value] {
  144.         global mylistbox_val_$module
  145.         set "mylistbox_val_${module}($label)" $value
  146.         }
  147.     }
  148.     }
  149. }
  150.  
  151. proc load_command {file} {
  152.     puts "(load $file commands)"
  153.     flush stdout
  154. }
  155.  
  156. proc load_script {file} {
  157.     puts "(load $file)"
  158.     flush stdout
  159. }
  160.  
  161. proc load_module {module} {
  162.     puts "(emodule-start $module)"
  163.     flush stdout
  164. }
  165.  
  166. # prefabricated screen
  167.  
  168. proc mkPrefab {} {
  169.     global ndroot env
  170.  
  171.     frame .prefab
  172.  
  173.     readndview "$ndroot/scripts/.ndview"
  174.     readndview "$env(HOME)/.ndview"
  175.     readndview ".ndview"
  176.  
  177.     mylistbox .prefab.envs environment "Environments" load_command
  178.     mylistbox .prefab.cmaps colormap "Colormaps" load_command
  179.     mylistbox .prefab.sample object "Sample objects" load_script
  180.  
  181.     frame .prefab.right
  182.     mylistbox .prefab.right.modules demo "Modules" load_module
  183.     button .prefab.right.help -text "Help" \
  184.     -command "viewfile .prefab.help text/prefabhelp.txt"
  185.     pack .prefab.right.modules
  186.     pack .prefab.right.help -expand 1 -fill x
  187.  
  188.     pack .prefab.envs .prefab.cmaps .prefab.sample .prefab.right \
  189.     -side left -padx 4 -pady 4 -expand 1 -fill both
  190. }
  191.  
  192. ################################################################
  193. # Toolkit stuff
  194.  
  195. proc scrollset {path command region} {
  196.     $path set 360 10 $region [expr $region+9]
  197.     eval $command $region
  198. }
  199.  
  200. proc myslider {path label command} {
  201.     frame $path
  202.     label $path.l -text $label
  203.     scale $path.s -from 0 -to 1 -resolution 0.01 -orient horizontal \
  204.     -showvalue no -command $command
  205.     pack $path.l -side left
  206.     pack $path.s -side left -fill x -expand 1
  207. }
  208.  
  209. proc setlens {val} {
  210.     puts "(merge cameral allcams {focus [expr $val*$val*50.0]})"
  211.     flush stdout
  212. }
  213.  
  214. proc setrotate {which val} {
  215.     foreach i {1 2 3} {
  216.     if $i!=$which {
  217.         .toolkit.sliders.s$i.s set 0
  218.     }
  219.     }
  220.     if $val==0 {
  221.     puts "(transform target focus focus rotate 0 0 0)"
  222.     } else {
  223.     puts [format "(transform-incr target focus focus rotate %s %f)" [lindex {{} "1.57 0 0" "0 1.57 0" "0 0 1.57"} $which] [expr 0.5/$val]]
  224.     }
  225.     flush stdout
  226. }
  227.  
  228. proc changedim {inc} {
  229.     global dimension;
  230.     set newdim [expr $dimension+$inc];
  231.     if $newdim<3 {
  232.     set newdim 3
  233.     }
  234.     set dimension $newdim
  235.     puts "(dimension $dimension)"
  236.     flush stdout
  237. }
  238.  
  239. proc newwin {} {
  240.     global dimension newwin_dims
  241.     catch {destroy .newwin}
  242.     toplevel .newwin
  243.     set i 1
  244.     frame .newwin.dims
  245.     while {$i<=$dimension} {
  246.     checkbutton .newwin.dims.dim$i -command "newwin_button $i" \
  247.         -text $i -variable dim$i
  248.     .newwin.dims.dim$i deselect
  249.     pack .newwin.dims.dim$i -side left
  250.     set i [expr $i+1]
  251.     }
  252.     button .newwin.ok -state disabled -command "newwin_ok" -text "done"
  253.     button .newwin.cancel -command "destroy .newwin" -text "cancel"
  254.     label .newwin.clusterlabel -text "cluster:"
  255.     entry .newwin.cluster -textvariable newwin_cluster -width 12 -relief sunken
  256.     pack .newwin.dims -side top
  257.     pack .newwin.ok .newwin.cancel .newwin.clusterlabel .newwin.cluster -side left
  258.     set newwin_dims {}
  259. }
  260.  
  261. proc newwin_button {num} {
  262.     global newwin_dims
  263.     if [lsearch $newwin_dims $num]>=0 {
  264. #    .newwin.dims.dim$num configure -state normal
  265.     set newwin_dims [lreplace $newwin_dims [lsearch $newwin_dims $num] [lsearch $newwin_dims $num]]
  266.     } else {
  267. #    .newwin.dims.dim$num configure -state active
  268.     lappend newwin_dims $num
  269.     }
  270.     if [llength $newwin_dims]==3 {
  271.     .newwin.ok configure -state normal
  272.     } else {
  273.     .newwin.ok configure -state disabled
  274.     }
  275. }
  276.  
  277. proc newwin_ok {} {
  278.     global newwin_dims newwin_cluster
  279.     set name $newwin_cluster:[join $newwin_dims _]
  280.     puts "(new-camera $name)"
  281.     set newwin_zerodims {}
  282.     foreach i $newwin_dims {
  283.     lappend newwin_zerodims [expr $i-1]
  284.     }
  285.     puts "(ND-axes $name $newwin_cluster $newwin_zerodims)"
  286.     flush stdout
  287.     destroy .newwin
  288. }
  289.  
  290. proc newmap {} {
  291.     puts "(emodule-start colormap)"
  292.     flush stdout
  293. }
  294.  
  295. # toolkit display
  296.  
  297. proc mkToolkit {} {
  298.     frame .toolkit
  299.     frame .toolkit.sliders
  300.  
  301.     myslider .toolkit.sliders.lens "Lens" "setlens"
  302.     .toolkit.sliders.lens.s set 0.245
  303.  
  304.     label .toolkit.sliders.rotations -text "Rotations:"
  305.     myslider .toolkit.sliders.s1 "s1" "setrotate 1"
  306.     myslider .toolkit.sliders.s2 "s2" "setrotate 2"
  307.     myslider .toolkit.sliders.s3 "s3" "setrotate 3"
  308.  
  309.     pack .toolkit.sliders.lens -side top -fill x -expand 1
  310.     pack .toolkit.sliders.rotations -side top -anchor w -fill x -expand 1
  311.     pack .toolkit.sliders.s1 -side top -fill x -expand 1
  312.     pack .toolkit.sliders.s2 -side top -fill x -expand 1
  313.     pack .toolkit.sliders.s3 -side top -fill x -expand 1
  314.  
  315.     pack .toolkit.sliders -fill x -expand 1 -side left -padx 2
  316.  
  317.     frame .toolkit.buttons
  318.     frame .toolkit.buttons.dim
  319.     button .toolkit.buttons.dim.plus -text "+" -command "changedim 1"
  320.     button .toolkit.buttons.dim.minus -text "-" -command "changedim -1"
  321.     label .toolkit.buttons.dim.val -textvariable dimension
  322.     pack .toolkit.buttons.dim.minus .toolkit.buttons.dim.val \
  323.     .toolkit.buttons.dim.plus -side left -expand 1 -fill both
  324.     set newwin_cluster cluster1
  325.     button .toolkit.buttons.newwin -text "New window" -command "newwin"
  326.     button .toolkit.buttons.newmap -text "New colormap" -command "newmap"
  327.     button .toolkit.buttons.help -text "Help" \
  328.     -command "viewfile .toolkit.help text/toolkithelp.txt"
  329.     pack .toolkit.buttons.dim .toolkit.buttons.newwin .toolkit.buttons.newmap \
  330.     .toolkit.buttons.help -expand 1 -fill x
  331.     pack .toolkit.buttons -side right -fill y -padx 2
  332. }
  333.  
  334. ################################################################
  335. # Basis vector stuff
  336.  
  337. # basis vectors
  338. proc myentry {num path args} {
  339.     eval "entry $path $args -relief sunken -bd 3"
  340.     bind $path <Return> "$path select from 0;$path select to end;ndview_spanproc $num"
  341. }
  342.  
  343.  
  344. proc mkBasis {} {
  345.     frame .basis
  346.  
  347.     frame .basis.l
  348.     label .basis.l.label -text "Image projected onto span {s1,s2,s3} where:"
  349.     frame .basis.l.left
  350.     label .basis.l.left.s1 -text "s1 = "
  351.     label .basis.l.left.s2 -text "s2 = "
  352.     label .basis.l.left.s3 -text "s3 = "
  353.     pack .basis.l.left.s1 .basis.l.left.s2 .basis.l.left.s3
  354.     frame .basis.l.right
  355.     myentry 1 .basis.l.right.s1 -width 20
  356.     myentry 2 .basis.l.right.s2 -width 20
  357.     myentry 3 .basis.l.right.s3 -width 20
  358.     pack .basis.l.right.s1 .basis.l.right.s2 .basis.l.right.s3 -fill x
  359.     pack .basis.l.label -side top
  360.     pack .basis.l.left -side left
  361.     pack .basis.l.right -side right -fill x -expand 1
  362.     frame .basis.r
  363.     label .basis.r.displabel -text "Displacement:"
  364.     myentry 4 .basis.r.disp -width 20
  365.     label .basis.r.viewlabel -text "Camera view from:"
  366.     myentry 5 .basis.r.view -width 20
  367.     pack .basis.r.displabel .basis.r.disp .basis.r.viewlabel .basis.r.view \
  368.     -fill x -expand 1
  369.  
  370.     frame .basis.b
  371.     frame .basis.b.i
  372.     label .basis.b.i.label -text "Information for:"
  373.     label .basis.b.i.target -textvariable basis_target
  374.     set basis_target mytarget
  375.     pack .basis.b.i.label .basis.b.i.target
  376.     frame .basis.b.update
  377.     label .basis.b.update.label -text "Update:"
  378.     radiobutton .basis.b.update.single -variable update -value "single" \
  379.     -text "Single (allow input)" -anchor w \
  380.     -command {ndview_set_update single}
  381.     radiobutton .basis.b.update.continuous -variable update \
  382.     -value "continuous" -text "Continuous" -anchor w \
  383.     -command {ndview_set_update continuous}
  384.     set update single
  385.     catch {ndview_set_update none}
  386.     set update continuous
  387.     pack .basis.b.update.label -side left
  388.     pack .basis.b.update.single .basis.b.update.continuous -fill x
  389.     button .basis.b.help -text "Help" \
  390.     -command "viewfile .basis.help text/axeshelp.txt"
  391.     pack .basis.b.i .basis.b.update .basis.b.help -side left -expand 1
  392.     pack .basis.b -side bottom -fill x
  393.     pack .basis.l .basis.r -side left -padx 2 -fill x -expand 1
  394.  
  395.     message .basis_needmore \
  396.     -text "Need at least 4 dimensions to see basis vectors." -width 200
  397. }
  398.  
  399. set update continuous
  400. set selected none
  401. set newwin_cluster default
  402. ndview_c_exists
  403. ndview_update_dimension
  404. mkTop
  405. mkIntro
  406. mkPrefab
  407. mkToolkit
  408. mkBasis
  409. wm resizable . 0 0
  410. setselect intro
  411.  
  412. puts "(bbox-draw allgeoms off)"
  413. puts "(ui-target g0)"
  414. flush stdout
  415.